;;; A mixin that lets you click a box in "select" mode and have it go straight to eval/invert

(defpackage :propagate-mixin
  (:use :cl)
  (:nicknames :pm)
  (:export :propagate-mixin
           :propagate-down-operation
           :propagate-up-operation
           :propagate-error-message
           :propagate))

(in-package :propagate-mixin)

(defclass propagate-mixin (bt:basic-trial)
  ())

(defgeneric propagate-down-operation (obj))
(defgeneric propagate-up-operation (obj))
(defgeneric propagate-error-message (obj node))

(defmethod p:start :before ((state propagate-mixin))
  ;; since these operations are never actually clicked, they don't
  ;; need to exist as buttons. So add them here to bypass vanilla's
  ;; button generating code. Since p:start calls show-hint, this is
  ;; the method to put them in, not state-init.
  (setf (p:operations state)
        (list*
         (propagate-down-operation state)
         (propagate-up-operation state)
         (p:operations state))))

(defun do-propagate (trial op)
  (p:do-operation trial (o:name op))
  (let ((input (d:find-if-on-tree (constantly t)
                                  (d:root (p:diagram trial))
                                  :only-type 'd:input-argument)))
    (setf (d:highlighted input) t
          (bt:input trial) (bt:read-input trial input))))

(defmethod do-propagate-up ((state propagate-mixin))
  (do-propagate state (propagate-up-operation state)))

(defmethod do-propagate-down ((state propagate-mixin))
  (do-propagate state (propagate-down-operation state)))

(exp:define-action propagate ((trial propagate-mixin)
                              (e:click-node :var id)
                              (bt:select-mode))
  (let ((node (d:find-id-or-die (d:root (p:diagram trial)) id)))
    (when (and (typep node 'd:argument)
               (null (d:quantity node)))
      (let* ((root (d:root (p:diagram trial)))
             (selected (d:selected-nodes root)))
        (d:clear-selected root)
        (setf (d:selected node) t)
        (cond
          ((o:find-transformation-for root (o:transformations (propagate-up-operation trial)))
           (do-propagate-up trial))
          ((o:find-transformation-for root (o:transformations (propagate-down-operation trial)))
           (do-propagate-down trial))
          (t
           (exp:lg 'click-node :node (d:id node))
           (propagate-error-message trial node)
           (setf (d:selected node) nil)
           (dolist (i selected)
             (setf (d:selected i) t))
           (setf (gwee:view-needs-update-p (p:diagram trial)) t)))))))
